home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
allswags.zip
/
CRC.SWG
< prev
next >
Wrap
Text File
|
1993-05-29
|
44KB
|
1 lines
SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00008 16/32 BIT CRC ROUTINES 1 05-28-9313:35ALL SWAG SUPPORT TEAM 16BITCRC Routines IMPORT 6 {π>I'm looking For code to calculate the CRC32 of a series of Characters.ππ ...Unless you're CRCing a very large amount of data, this CRC-16π routine should do.ππ NOTE: This routine requires either TP6 or TP7 to compile.π}ππ{ Return a 16-bit CRC number For binary data. }ππFunction Crc16(Var Data; wo_Size : Word) : Word; Assembler;πAsmπ push dsπ xor dx, dxπ lds si, Dataπ mov bx, wo_Sizeπ@L1:π xor ah, ahπ lodsbπ mov cx, 8π shl ax, clπ xor dx, axπ mov cx, 8π@L2:π shl dx, 1π jnc @L3π xor dx, $1021π@L3:π loop @L2π dec bxπ jnz @L1π pop dsπ mov ax, dxπend; { Crc16. } 2 05-28-9313:35ALL SWAG SUPPORT TEAM File CHECKSUM IMPORT 21 {nice Program/utility which can be used to check the 'sorted' File and the dataπFile. It produces the Byte CheckSum of the Files (which must be identical), andπcan check the sortorder of the File (when given the option -s)...π}π{$A+,B-,D-,F-,G+,I-,L-,N-,O-,R-,S+,V-,X-}π{$M 16384,0,655360}π{ Here is the Program CHECKSUM that you can run to check the master dataπ File For TeeCee's String sorting contest. if you have a slow machine Iπ suggest you set the Program running and go to bed!! :-)ππ Code size: 5952 Bytesπ Data size: 924 Bytesπ .EXE size: 6304 Bytesπ}πUses Crt;πConstπ Version = 'CheckSum 1.0 (c) 1992 DwarFools & Consultancy, '+π 'by drs. Robert E. Swart'#13#10;π Usage = 'Usage: CheckSum dataFile [-s]'#13#10 +π ' Options: -s to check the sortorder of the Strings'#13#10;π MaxStr = 30;π Error: LongInt = 0;π Records: LongInt = 0;π CheckSum: Byte = 0; { Byte CheckSum of all Bytes in data File xor'ed }π Sortorder: Boolean = False; { Assume option -s is not given }ππVar Str: String[MaxStr];π len: Byte Absolute Str;π ByteStr: Array[0..MaxStr] of Byte Absolute Str;π PrevStr,UpperStr: String[MaxStr];π f: File;π i: Integer;ππbeginπ Writeln(Version);π if ParamCount = 0 thenπ beginπ Writeln(Usage);π Haltπ end;ππ assign(f,ParamStr(1)); { Change this to your chosen File name }π reset(f,1);π if Ioresult <> 0 thenπ beginπ Writeln('Error: could not open ',ParamStr(1));π Writeln(Usage);π Halt(1)π end;ππ if (ParamCount = 2) andπ ((ParamStr(2) = '-s') or (ParamStr(2) = '-S')) then Sortorder := True;ππ Writeln('Strings x 1000 checked:');π While not eof(f) doπ beginπ BlockRead(f,len,1);π BlockRead(f,Str[1],len);π For i:=0 to len do CheckSum := CheckSum xor ByteStr[i];π if Sortorder thenπ beginπ UpperStr[0] := Str[0];π For i:=1 to len do UpperStr[i] := UpCase(Str[i]);π if Records > 0 thenπ beginπ if PrevStr > UpperStr thenπ beginπ Inc(Error);π Writeln;π Writeln('Error: ',PrevStr,' > ',UpperStr);π end;π PrevStr := UpperStrπ endπ end;π Inc(Records);π if (Records mod 1000) = 0 thenπ beginπ GotoXY(1,WhereY);π Write(Records div 1000:3);π endπ end;π close(f);π Writeln;π Write(Records,' Strings checked, ');π if Sortorder then Writeln(Error,' Errors found, ');π Writeln('Byte CheckSum = ',CheckSum)πend.π 3 05-28-9313:35ALL SWAG SUPPORT TEAM 16 BIT CRC IMPORT 35 {π The following is a Turbo/Quick Pascal Implementation of calculatingπ the XModem Type of 16-bit cyclic redundancy checking (CRC).ππ Is there a preference For the language of the next CRC-16 exampleπ (80x86 Assembly, BASIC, or C) ?π}ππ(*******************************************************************)πProgram TPCRC16; { Compiler: TurboPascal 4.0+ & QuickPascal 1.0+ }π{ Turbo Pascal 16-bit Cyclic Redundancy Checking (CRC) a.la. XModem }π{ Greg Vigneault, Box 7169, Station A, toronto, Canada M5W 1X8. }ππConst Beep = #7; { ASCII bell tone }πType bArray = Array [1..$4000] of Byte; { define buffer }π bPointer = ^bArray; { Pointer to buffer }πVar DataPtr : bPointer; { Pointer to data }π fName : String; { File name }π fHandle : File; { File handle }π BytesIn : Word; { For counting data }π CRC16 : Integer; { running CRC-16 }ππ{-------------------------------------------------------------------}π Procedure WriteHex( raw : Integer ); { display hexadecimal value }π Var ch : Char;π shft : Byte;π beginπ if (raw = 0) then Write('0') { if zero }π else beginπ shft := 16; { bit count }π Repeat { isolate each hex nibble, and convert to ASCII }π DEC( shft, 4 ); { shift by nibble }π ch := CHR( raw SHR shft and $F or orD('0') ); {0..9 }π if (ch > '9') then inC( ch, 7 ); {A..F }π Write( ch ); { display the digit }π Until (shft = 0);π end;π end {WriteHex};ππ{-------------------------------------------------------------------}π Function UpdateCRC16(CRC : Integer; { CRC-16 to update }π InBuf : bPointer; { Pointer to data }π InLen : Integer) :Integer; { data count }π Var Bit, ByteCount : Integer;π Carry : Boolean; { catch overflow }π beginπ For ByteCount := 1 to InLen do { all data Bytes }π For Bit := 7 doWNto 0 do begin { 8 bits per Byte }π Carry := CRC and $8000 <> 0; { shift overlow? }π CRC := CRC SHL 1 or InBuf^[ByteCount] SHR Bit and 1;π if Carry then CRC := CRC xor $1021; { apply polynomial }π end; { For Bit & ByteCount } { all Bytes & bits }π UpdateCRC16 := CRC; { updated CRC-16 }π end {UpdateCRC16};ππ{-------------------------------------------------------------------}πbeginπ if ( MaxAvail < Sizeof(bArray) ) then begin { check For memory }π WriteLn( 'not enough memory!', Beep );π Halt(1);π end;π if (ParamCount <> 1) then begin { File name input? }π WriteLn( 'Use TPCRC16 <fName>', Beep );;π Halt(2);π end;π fName := ParamStr(1); { get File name }π Assign( fHandle, fName ); { open the File }π {$i-} Reset( fHandle, 1 ); {$i+} { open succeeded? }π if (IoResult <> 0) then begin { if not ... }π WriteLn( 'File access ERRor', Beep );π Halt(3);π end;π New( DataPtr ); { allocate memory }π CRC16 := 0; { initialize CRC-16 }π Repeatπ BlockRead( fHandle, DataPtr^[1], Sizeof(bArray), BytesIn );π CRC16 := UpdateCRC16( CRC16, DataPtr, BytesIn );π Until (BytesIn <> Sizeof(bArray)) or Eof(fHandle);π Close( fHandle ); { close input File }π DataPtr^[1] := 0; DataPtr^[2] := 0; { insert two nulls }π CRC16 := UpdateCRC16( CRC16, DataPtr, 2 ); { For final calc }π Dispose( DataPtr ); { release memory }π Write( 'The CRC-16 of File ', fName, ' is $' );π WriteHex( CRC16 ); WriteLn;ππend {TPCRCXMO}.π(*********************************************************************)π 4 05-28-9313:35ALL SWAG SUPPORT TEAM Another 16Bit CRC IMPORT 27 Unit Crc16;πInterfaceπ{ Note: Your crc Variable must be initialized to 0, before }π{ using tis routine. }π{ Translated to Turbo Pascal (tm) V4.0 March, 1988 by J.R.Louvau }π{ }πFunction UpdCrc(cp: Byte; crc: Word): Word;ππImplementationππ(* crctab calculated by Mark G. Mendel, Network Systems Corporation *)πConst crctab : Array[0..255] of Word = (π $0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,π $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef,π $1231, $0210, $3273, $2252, $52b5, $4294, $72f7, $62d6,π $9339, $8318, $b37b, $a35a, $d3bd, $c39c, $f3ff, $e3de,π $2462, $3443, $0420, $1401, $64e6, $74c7, $44a4, $5485,π $a56a, $b54b, $8528, $9509, $e5ee, $f5cf, $c5ac, $d58d,π $3653, $2672, $1611, $0630, $76d7, $66f6, $5695, $46b4,π $b75b, $a77a, $9719, $8738, $f7df, $e7fe, $d79d, $c7bc,π $48c4, $58e5, $6886, $78a7, $0840, $1861, $2802, $3823,π $c9cc, $d9ed, $e98e, $f9af, $8948, $9969, $a90a, $b92b,π $5af5, $4ad4, $7ab7, $6a96, $1a71, $0a50, $3a33, $2a12,π $dbfd, $cbdc, $fbbf, $eb9e, $9b79, $8b58, $bb3b, $ab1a,π $6ca6, $7c87, $4ce4, $5cc5, $2c22, $3c03, $0c60, $1c41,π $edae, $fd8f, $cdec, $ddcd, $ad2a, $bd0b, $8d68, $9d49,π $7e97, $6eb6, $5ed5, $4ef4, $3e13, $2e32, $1e51, $0e70,π $ff9f, $efbe, $dfdd, $cffc, $bf1b, $af3a, $9f59, $8f78,π $9188, $81a9, $b1ca, $a1eb, $d10c, $c12d, $f14e, $e16f,π $1080, $00a1, $30c2, $20e3, $5004, $4025, $7046, $6067,π $83b9, $9398, $a3fb, $b3da, $c33d, $d31c, $e37f, $f35e,π $02b1, $1290, $22f3, $32d2, $4235, $5214, $6277, $7256,π $b5ea, $a5cb, $95a8, $8589, $f56e, $e54f, $d52c, $c50d,π $34e2, $24c3, $14a0, $0481, $7466, $6447, $5424, $4405,π $a7db, $b7fa, $8799, $97b8, $e75f, $f77e, $c71d, $d73c,π $26d3, $36f2, $0691, $16b0, $6657, $7676, $4615, $5634,π $d94c, $c96d, $f90e, $e92f, $99c8, $89e9, $b98a, $a9ab,π $5844, $4865, $7806, $6827, $18c0, $08e1, $3882, $28a3,π $cb7d, $db5c, $eb3f, $fb1e, $8bf9, $9bd8, $abbb, $bb9a,π $4a75, $5a54, $6a37, $7a16, $0af1, $1ad0, $2ab3, $3a92,π $fd2e, $ed0f, $dd6c, $cd4d, $bdaa, $ad8b, $9de8, $8dc9,π $7c26, $6c07, $5c64, $4c45, $3ca2, $2c83, $1ce0, $0cc1,π $ef1f, $ff3e, $cf5d, $df7c, $af9b, $bfba, $8fd9, $9ff8,π $6e17, $7e36, $4e55, $5e74, $2e93, $3eb2, $0ed1, $1ef0π);ππ(*π * updcrc derived from article Copyright (C) 1986 Stephen Satchell.π * NOTE: First argument must be in range 0 to 255.π * Second argument is referenced twice.π *π * Programmers may incorporate any or all code into their Programs,π * giving proper credit within the source. Publication of theπ * source routines is permitted so long as proper credit is givenπ * to Stephen Satchell, Satchell Evaluations and Chuck Forsberg,π * Omen Technology.π *)πFunction UpdCrc(cp: Byte; crc: Word): Word;πbegin { UpdCrc }π UpdCrc := crctab[((crc SHR 8) and 255)] xor (crc SHL 8) xor cpπend;ππend. {Unit}π 5 05-28-9313:35ALL SWAG SUPPORT TEAM Checksum/16/32 CRC IMPORT 72 { Default Compiler Directives}π{$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT CRC;ππINTERFACEππfunction UpdateChecksum(CurByte : Byte; CheckSum : Word) : Word;π {-Returns an updated checksum}ππfunction UpdateCrc(CurByte : Byte; CurCrc : Word) : Word;π {-Returns an updated Crc16}ππFUNCTION UPDateCrcReverse (curByte : BYTE; CurCRC : WORD) : WORD;π { -returns reversed crc16}ππfunction UpdateCrcKermit(CurByte : Byte; CurCrc : Word) : Word;π {-Returns an updated Crc16 (kermit style)}ππconstπ Crc32Table : array[0..255] of LongInt = (π $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535,π $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd,π $e7b82d07, $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d,π $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec,π $14015c4f, $63066cd9, $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4,π $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,π $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59, $26d930ac,π $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,π $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab,π $b6662d3d, $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f,π $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb,π $086d3d2d, $91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,π $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, $8bbeb8ea,π $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65, $4db26158, $3ab551ce,π $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a,π $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,π $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409,π $ce61e49f, $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,π $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739,π $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8,π $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, $8708a3d2, $1e01f268,π $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7, $fed41b76, $89d32be0,π $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8,π $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,π $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,π $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703,π $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7,π $b5d0cf31, $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, $026d930a,π $9c0906a9, $eb0e363f, $72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae,π $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,π $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777, $88085ae6,π $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,π $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d,π $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5,π $47b2cf7f, $30b5ffe9, $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605,π $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,π $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8dπ );ππvarπ Crc32TableOfs : Word;ππfunction UpdateCrc32(CurByte : Byte; CurCrc : LongInt) : LongInt;π {-Returns an updated crc32}ππ (* Model for inline code belowπ UpdateCrc32 := Crc32Table[Byte(CurCrc xor LongInt(CurByte))] xorπ ((CurCrc shr 8) and $00FFFFFF);π *)ππInline(π {;Get args -- DX:BX = CurCrc, CX = CurByte;}π $5B/ { POP BX}π $5A/ { POP DX}π $59/ { POP CX}π $52/ { PUSH DX}π $53/ { PUSH BX ;Save original CurCrc}π {;CX:AX := Get Crc32Table[CurCrc xor CurByte];} {!!.10}π $31/$CB/ { XOR BX,CX ;DX:BX = CurCrc xor CurByte}π $30/$FF/ { XOR BH,BH ;Byte(DX:BX)}π $D1/$E3/ { SHL BX,1 ;LongInt index}π $D1/$E3/ { SHL BX,1}π { $C4/$87/>CRC32TABLE/ LES AX,>Crc32Table[BX]} {!!.10}π $03/$1E/>CRC32TABLEOFS/{ ADD BX,[>Crc32TableOfs]} {!!.10}π $8B/$07/ { MOV AX,[BX]} {!!.10}π $8B/$4F/$02/ { MOV CX,[BX+2]} {!!.10}π {;DX:BX := (CurCrc shr 8) and $00FFFFFF;}π $5B/ { POP BX ;Get original CurCrc}π $5A/ { POP DX}π $51/ { PUSH CX ;Save CX} {!!.10}π $B9/$08/$00/ { MOV CX,8 ;Shift 8 bits}π $D1/$EA/ {C1: SHR DX,1 ;Hi reg into carry}π $D1/$DB/ { RCR BX,1 ;Carry into lo reg}π $E2/$FA/ { LOOP C1 ; for 8 bits}π $81/$E2/$FF/$00/ { AND DX,$00FF}π {;DX:AX := ES:AX xor DX:BX (sets function result)}π $59/ { POP CX} {!!.10}π $31/$D8/ { XOR AX,BX}π $89/$CB/ { MOV BX,CX} {!!.10}π $31/$DA); { XOR DX,BX}ππconstπ {The following table is used internally only. It is interfaced soπ that other programmers can use them with their own CRC routines}ππ CrcTable: array[0..255] of Word = (π $0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,π $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef,π $1231, $0210, $3273, $2252, $52b5, $4294, $72f7, $62d6,π $9339, $8318, $b37b, $a35a, $d3bd, $c39c, $f3ff, $e3de,π $2462, $3443, $0420, $1401, $64e6, $74c7, $44a4, $5485,π $a56a, $b54b, $8528, $9509, $e5ee, $f5cf, $c5ac, $d58d,π $3653, $2672, $1611, $0630, $76d7, $66f6, $5695, $46b4,π $b75b, $a77a, $9719, $8738, $f7df, $e7fe, $d79d, $c7bc,π $48c4, $58e5, $6886, $78a7, $0840, $1861, $2802, $3823,π $c9cc, $d9ed, $e98e, $f9af, $8948, $9969, $a90a, $b92b,π $5af5, $4ad4, $7ab7, $6a96, $1a71, $0a50, $3a33, $2a12,π $dbfd, $cbdc, $fbbf, $eb9e, $9b79, $8b58, $bb3b, $ab1a,π $6ca6, $7c87, $4ce4, $5cc5, $2c22, $3c03, $0c60, $1c41,π $edae, $fd8f, $cdec, $ddcd, $ad2a, $bd0b, $8d68, $9d49,π $7e97, $6eb6, $5ed5, $4ef4, $3e13, $2e32, $1e51, $0e70,π $ff9f, $efbe, $dfdd, $cffc, $bf1b, $af3a, $9f59, $8f78,π $9188, $81a9, $b1ca, $a1eb, $d10c, $c12d, $f14e, $e16f,π $1080, $00a1, $30c2, $20e3, $5004, $4025, $7046, $6067,π $83b9, $9398, $a3fb, $b3da, $c33d, $d31c, $e37f, $f35e,π $02b1, $1290, $22f3, $32d2, $4235, $5214, $6277, $7256,π $b5ea, $a5cb, $95a8, $8589, $f56e, $e54f, $d52c, $c50d,π $34e2, $24c3, $14a0, $0481, $7466, $6447, $5424, $4405,π $a7db, $b7fa, $8799, $97b8, $e75f, $f77e, $c71d, $d73c,π $26d3, $36f2, $0691, $16b0, $6657, $7676, $4615, $5634,π $d94c, $c96d, $f90e, $e92f, $99c8, $89e9, $b98a, $a9ab,π $5844, $4865, $7806, $6827, $18c0, $08e1, $3882, $28a3,π $cb7d, $db5c, $eb3f, $fb1e, $8bf9, $9bd8, $abbb, $bb9a,π $4a75, $5a54, $6a37, $7a16, $0af1, $1ad0, $2ab3, $3a92,π $fd2e, $ed0f, $dd6c, $cd4d, $bdaa, $ad8b, $9de8, $8dc9,π $7c26, $6c07, $5c64, $4c45, $3ca2, $2c83, $1ce0, $0cc1,π $ef1f, $ff3e, $cf5d, $df7c, $af9b, $bfba, $8fd9, $9ff8,π $6e17, $7e36, $4e55, $5e74, $2e93, $3eb2, $0ed1, $1ef0π );ππimplementationππ function UpdateChecksum(CurByte : Byte; CheckSum : Word) : Word;π {-Returns an updated checksum}π beginπ UpdateCheckSum := CheckSum + CurByte;π end;ππ function UpdateCrc(CurByte : Byte; CurCrc : Word) : Word;π {-Returns an updated CRC16}π beginπ UpdateCrc := CrcTable[((CurCrc shr 8) and 255)] xorπ (CurCrc shl 8) xor CurByte;π end;ππ FUNCTION UPDateCrcReverse (curByte : BYTE; CurCRC : WORD) : WORD;π BEGIN { Updatecrcreverse .. need to be reversed for YMODEM,XMODEM }π UpDateCRCReverse := (Curcrc SHL 8) XOR ( CRCtable [ (curcrc SHR 8) XOR curByte] );π END;ππ function UpdateCrcKermit(CurByte : Byte; CurCrc : Word) : Word;π {-Returns an updated Crc16 (kermit style)}π varπ I : Integer;π Temp : Integer;π beginπ for I := 0 to 7 do beginπ Temp := CurCrc xor CurByte;π CurCrc := CurCrc shr 1;π if Odd(Temp) thenπ CurCrc := CurCrc xor $8408;π CurByte := CurByte shr 1;π end;π UpdateCrcKermit := CurCrc;π end;ππBEGIN { initialize CRC32 table }π Crc32TableOfs := Ofs(Crc32Table);πEND. 6 05-28-9313:35ALL SWAG SUPPORT TEAM 32 Bit CRC IMPORT 42 {π> I was kind of hoping to be ushered toward a File name I could locateπ> which would do what I need. (Produce 32 bit CRC's that are compatibleπ> With PKZIP's output).ππ I snagged this of this echo sometime ago. It does CRC32π using only TP With the help of a precalculated table.π It does procduce CRC32 values that are the same as PKZIP and ARJ.ππ--------------------- Unit CRC32C.PAS 8<-----------------------π{ Modified from a version posted on the Pascal echo by Floorπ A.C. Naaijkens (note introduction of a Constant and aπ Function and making the Array a Constant outside ofπ crc32() which should improve speed a lot; furtherπ references made to a C version in a File of Snippets from theπ(112 min left), (H)elp, More? C Echo marked as "Copyright (C) 1986 Gary S. Brown" (mostly toπ compare the large Arrays, which proved to be identical), and toπ "File verification using CRC" by Mark R. Nelson in Dr. Dobbs'π Journal, May 1992. The latter provided the final piece ofπ crucial information. Use: 1) Create a LongInt Variable For theπ CRC value; 2) Initialize this With CRCSeed; 3) Build theπ CRC Byte-by-Byte With CRC32(); 4) Finish With CRCend()π (this was the part I found in Nelson). The result is a CRCπ value identical to that calculated by PKZip and ARJ.π}πUnit CRC32c;πInterfaceπ Constπ CRCSeed = $ffffffff;π CRC32tab : Array[0..255] of LongInt = (π $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f,π $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,π $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064, $6ab020f2,π $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,π $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,π $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172,π $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,π $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,π $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423,π $cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,π $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,π $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,π $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d,π $91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,π $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,π $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,π $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7,π $a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,π $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa,π $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,π $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,π $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,π $ead54739, $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84,π $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,π $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,π $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,π $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e,π $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,π $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55,π $316e8eef, $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,π $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28,π $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,π $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f,π $72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,π $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,π $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,π $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69,π $616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,π $a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,π $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,π $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693,π $54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,π $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d );πFunction CRC32(value: Byte; crc: LongInt) : LongInt;πFunction CRCend( crc : LongInt ) : LongInt ;ππImplementationππFunction CRC32(value: Byte; crc: LongInt) : LongInt;πbeginπ CRC32 := CRC32tab[Byte(crc xor LongInt(value))] xorπ ((crc shr 8) and $00ffffff);πend;ππFunction CRCend( crc : LongInt ): LongInt;πbeginπ CRCend := (crc xor CRCSeed);πend;ππend.ππ{πNow to use it...ππWith a LongInt Variable, say vCRC32, first seed itπ vCRC32 := CRCSeed;πThen go Byte-by-Byte thorugh to calculate:π For P := 1 to Size DOπ vCRC32 := CRC32(Bytes[P], vCRC32);ππ Then finish it off With CRCendππ vCRC32 := CRCend(vCRC32);ππ You should be able to Write your own Dec2Hex Function =)π}π 7 05-28-9313:35ALL SWAG SUPPORT TEAM File CRC Routines IMPORT 81 {πAuthor: FLOOR A.C. NAAIJKENSππPart of The ECO Library II:π}ππUnit Eco_CRC;ππInterfaceππFunction __CRC32(Value: Byte; CRC : LongInt) : LongInt;πFunction __CRC16(Value: Byte; CRC : Word) : Word;ππImplementationππFunction __crc32(value: Byte; crc: LongInt): LongInt;πConstπ crc32_table : Array[0..255] of LongInt = (π $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f,π $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,π $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064, $6ab020f2,π $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,π $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,π $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172,π $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,π $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,π $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423,π $cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,π $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,π $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,π $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d,π $91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,π $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,π $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,π $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7,π $a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,π $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa,π $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,π $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,π $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,π $ead54739, $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84,π $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,π $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,π $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,π $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e,π $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,π $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55,π $316e8eef, $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,π $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28,π $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,π $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f,π $72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,π $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,π $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,π $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69,π $616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,π $a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,π $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,π $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693,π $54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,π $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8dπ );ππbeginπ if crc = 0 thenπ crc := $ffffffff; { must be set high to start With }π __crc32 := crc32_table[Byte(crc xor LongInt(value))] xorπ ((crc shr 8) and $00ffffff);πend;ππππFunction __crc16(value: Byte; crc: Word): Word;πConstπ crc16_table : Array[0..255] of Word = (π $0000, $1021, $2042, $3063, $4084, $50a5, $60c6, $70e7,π $8108, $9129, $a14a, $b16b, $c18c, $d1ad, $e1ce, $f1ef,π $1231, $0210, $3273, $2252, $52b5, $4294, $72f7, $62d6,π $9339, $8318, $b37b, $a35a, $d3bd, $c39c, $f3ff, $e3de,π $2462, $3443, $0420, $1401, $64e6, $74c7, $44a4, $5485,π $a56a, $b54b, $8528, $9509, $e5ee, $f5cf, $c5ac, $d58d,π $3653, $2672, $1611, $0630, $76d7, $66f6, $5695, $46b4,π $b75b, $a77a, $9719, $8738, $f7df, $e7fe, $d79d, $c7bc,π $48c4, $58e5, $6886, $78a7, $0840, $1861, $2802, $3823,π $c9cc, $d9ed, $e98e, $f9af, $8948, $9969, $a90a, $b92b,π $5af5, $4ad4, $7ab7, $6a96, $1a71, $0a50, $3a33, $2a12,π $dbfd, $cbdc, $fbbf, $eb9e, $9b79, $8b58, $bb3b, $ab1a,π $6ca6, $7c87, $4ce4, $5cc5, $2c22, $3c03, $0c60, $1c41,π $edae, $fd8f, $cdec, $ddcd, $ad2a, $bd0b, $8d68, $9d49,π $7e97, $6eb6, $5ed5, $4ef4, $3e13, $2e32, $1e51, $0e70,π $ff9f, $efbe, $dfdd, $cffc, $bf1b, $af3a, $9f59, $8f78,π $9188, $81a9, $b1ca, $a1eb, $d10c, $c12d, $f14e, $e16f,π $1080, $00a1, $30c2, $20e3, $5004, $4025, $7046, $6067,π $83b9, $9398, $a3fb, $b3da, $c33d, $d31c, $e37f, $f35e,π $02b1, $1290, $22f3, $32d2, $4235, $5214, $6277, $7256,π $b5ea, $a5cb, $95a8, $8589, $f56e, $e54f, $d52c, $c50d,π $34e2, $24c3, $14a0, $0481, $7466, $6447, $5424, $4405,π $a7db, $b7fa, $8799, $97b8, $e75f, $f77e, $c71d, $d73c,π $26d3, $36f2, $0691, $16b0, $6657, $7676, $4615, $5634,π $d94c, $c96d, $f90e, $e92f, $99c8, $89e9, $b98a, $a9ab,π $5844, $4865, $7806, $6827, $18c0, $08e1, $3882, $28a3,π $cb7d, $db5c, $eb3f, $fb1e, $8bf9, $9bd8, $abbb, $bb9a,π $4a75, $5a54, $6a37, $7a16, $0af1, $1ad0, $2ab3, $3a92,π $fd2e, $ed0f, $dd6c, $cd4d, $bdaa, $ad8b, $9de8, $8dc9,π $7c26, $6c07, $5c64, $4c45, $3ca2, $2c83, $1ce0, $0cc1,π $ef1f, $ff3e, $cf5d, $df7c, $af9b, $bfba, $8fd9, $9ff8,π $6e17, $7e36, $4e55, $5e74, $2e93, $3eb2, $0ed1, $1ef0π );ππbeginπ __crc16 := crc16_table[((crc shr 8) and 255)] xorπ (crc shl 8) xor value;πend;ππππend.ππ{==========================================================================}π{==========================================================================}π{==========================================================================}ππCRC.PASπ{$M 65520, 0, 655360}πUsesπ Crt, Dos,π eco_lib;ππVarπ take32,π take16 : Boolean;π sourcepath,π source : String;π numFiles, i : Word;π srec : SearchRec;π filar : Array[1..1024] of ^SearchRec;ππππFunction convert32(fname: String; fsize: LongInt; x1, x2, y: Byte): String;πConstπ bufsize = 32768;πTypeπ fbuf = Array[1..bufsize] of Byte;πVarπ i : Word;π source : File;π bread : Word;π Filebuf : ^fbuf;π crc, tr : LongInt;π nr : Real;ππbeginπ crc := $ffffffff;π tr := 0;π new(Filebuf);π assign(source, fname);π reset(source, 1);π GotoXY(x1, y);π Write(__rep(x2-x1-3, '░'));π Write(' ', fname);π Repeatπ blockread(source, Filebuf^, bufsize, bread);π tr := tr + bread;π nr := tr/fsize;π nr := nr * (x2-x1-3);π GotoXY(x1, y);π Write(__rep(trunc(nr), '█'));π For i := 1 to bread doπ crc := __crc32(Filebuf^[i], crc);π Until (bread = 0);π close(source);π GotoXY(x1, y);π dispose(Filebuf);π Write(fname:12, ' ', fsize:7, ' Bytes. HEX-CRC/32: ',__tohexstr(crc, 4));π clreol; convert32 := '';πend;ππFunction convert16(fname: String; fsize: LongInt; x1, x2, y: Byte): String;πConstπ bufsize = 32768;πTypeπ fbuf = Array[1..bufsize] of Byte;πVarπ i : Word;π source : File;π bread : Word;π Filebuf : ^fbuf;π crc, tr : LongInt;π nr : Real;ππbeginπ crc := $0000;π tr := 0;π new(Filebuf);π assign(source, fname);π reset(source, 1);π GotoXY(x1, y);π Write(__rep(x2-x1-3, '░'));π Write(' ', fname);π Repeatπ blockread(source, Filebuf^, bufsize, bread);π tr := tr + bread;π nr := tr/fsize;π nr := nr * (x2-x1-3);π GotoXY(x1, y);π Write(__rep(trunc(nr), '█'));π For i := 1 to bread doπ crc := __crc16(Filebuf^[i], crc);π Until (bread = 0);π close(source);π GotoXY(x1, y);π dispose(Filebuf);π Write(fname:12, ' ', fsize:7, ' Bytes. HEX-CRC/16: ', __tohexstr(crc, 2));π clreol;π convert16 := '';πend;ππππFunction convert16_32(fname:String; fsize: LongInt; x1, x2, y: Byte):String;πConstπ bufsize = 32768;πTypeπ fbuf = Array[1..bufsize] of Byte;πVarπ i : Word;π source : File;π bread : Word;π Filebuf : ^fbuf;π crc,π crc32,π tr : LongInt;π nr : Real;ππbeginπ crc := $0000;π tr := 0;π crc32 := $ffffffff;π new(Filebuf);π assign(source, fname);π reset(source, 1);π GotoXY(x1, y);π Write(__rep(x2-x1-3, '░'));π Write(' ', fname);π Repeatπ blockread(source, Filebuf^, bufsize, bread);π tr := tr + bread;π nr := tr/fsize;π nr := nr * (x2-x1-3);π GotoXY(x1, y);π Write(__rep(trunc(nr), '█'));π For i := 1 to bread do beginπ crc := __crc16(Filebuf^[i], crc);π crc32 := __crc32(Filebuf^[i], crc32);π end;π Until (bread = 0);π close(source);π GotoXY(x1, y);π dispose(Filebuf);π Write(fname:12, ' ', fsize:7,' Bytes. HEX-CRC/16: ', __tohexstr(crc, 2),π ' 32: ', __tohexstr(crc32, 4));π clreol;π convert16_32 := '';πend;πππππ{main}πbeginπ source := fexpand(paramstr(1));π take32 := False;π take16 := False;π if paramstr(2) = '/32' thenπ take32 := True;π if paramstr(2) = '/16' thenπ take16 := True;π numFiles := 0;π findfirst(source, anyFile, srec);π While Doserror=0 doπ beginπ if not (((srec.attr and directory) > 0) or ((srec.attr and volumeid) > 0)π and (srec.size > 0)) thenπ beginπ inc(numFiles);π new(filar[numFiles]);π filar[numFiles]^ := srec;π filar[numFiles]^.name := __up(filar[numFiles]^.name);π end; findnext(srec);π end;π Writeln(numFiles, ' File(s) found.');ππ For i := 1 to numFiles doπ if take32 thenπ Writeln(convert32(sourcepath + filar[i]^.name, filar[i]^.size,π 5, 35, WhereY))π elseπ if take16 thenπ Writeln(convert16(sourcepath + filar[i]^.name, filar[i]^.size,π 5, 35, WhereY))π elseπ Writeln(convert16_32(sourcepath + filar[i]^.name, filar[i]^.size,π 5, 35, WhereY));πend.ππππ 8 05-28-9313:35ALL SWAG SUPPORT TEAM File MODS With CRC Check IMPORT 62 {$X+}πUnit selfmod;ππ { Author Trevor J Carlsen - released into the public domain 1991 }π { PO Box 568 }π { Port Hedland } π { Western Australia 6721 }π { Voice +61 91 73 2026 Data +61 91 73 2569 }π { FidoNet 3:690/644 }π { Allows a Program to self modify a Typed Constant in the .exe File. It }π { also perForms an automatic checksum Type .exe File integrity check. }π { A LongInt value is added to the end of the exe File. This can be read by }π { a separate configuration Program to enable it to determine the start of }π { the Programs configuration data area. to use this the configuration }π { Typed Constant should be added immediately following the declaration of }π { ExeData. }π π { Where this Unit is used, it should always be the FIRST Unit listed in the }π { Uses declaration area of the main Program. }π π { Requires Dos 3.3 or later. Program must not be used With PKLite or LZExe }π { or any similar exe File Compression Programs. It may also cause }π { difficulties on a network or virus detection Programs. }π π { The stack size needed is at least 9,000 Bytes. }π πInterfaceππUsesπ globals;ππTypeπ ExeDataType = Recordπ IDStr : str7;π UserName : str35;π FirstTime : Boolean;π NumbExecs : shortint;π Hsize : Word;π ExeSize : LongInt;π CheckSum : LongInt;π StartConst : LongInt;π RegCode : LongInt;π end;πConstπ ExeData : ExeDataType = (IDStr : 'ID-AREA';π UserName : '';π FirstTime : True;π NumbExecs : -1;π Hsize : 0;π ExeSize : 0;π CheckSum : 0;π StartConst: 0;π RegCode : 0);πππ{$I p:\prog\freeload.inc} { Creates CodeStr that MUST match RegStr }ππ{$I p:\prog\registed.inc} { Creates CodeChkStr that MUST hash to RegCode}ππConstπ mark : Byte = 0;ππVarπ first : Boolean;ππProcedure Hash(p : Pointer; numb : Byte; Var result: LongInt);ππFunction Write2Exec(Var data; size: Word): Boolean;ππImplementationπππProcedure Hash(p : Pointer; numb : Byte; Var result: LongInt);π { When originally called numb must be equal to sizeof }π { whatever p is pointing at. if that is a String numb }π { should be equal to length(the_String) and p should be } π { ptr(seg(the_String),ofs(the_String)+1) }π Varπ temp,π w : LongInt;π x : Byte;ππ beginπ temp := LongInt(p^); RandSeed := temp;π For x := 0 to (numb - 4) do beginπ w := random(maxint) * random(maxint) * random(maxint);π temp := ((temp shr random(16)) shl random(16)) +π w + MemL[seg(p^):ofs(p^)+x];π end;π result := result xor temp;π end; { Hash }πππProcedure InitConstants;π Varπ f : File;π tbuff : Array[0..1] of Word;π π Function GetCheckSum : LongInt; π { PerForms a checksum calculation on the exe File }π Varπ finished : Boolean;π x,π CSum : LongInt;π BytesRead : Word;π buffer : Array[0..4095] of Word;π beginπ {$I-}π seek(f,0);π finished := False; CSum := 0; x := 0;π BlockRead(f,buffer,sizeof(buffer),BytesRead);π While not finished do begin { do the checksum calculations }π Repeat { Until File has been read up to start of config area }π inc(CSum,buffer[x mod 4096]);π inc(x);π finished := ((x shl 1) >= ExeData.StartConst); π Until ((x mod 4096) = 0) or finished;π if not finished then { data area has not been reached }π BlockRead(f,buffer,sizeof(buffer),BytesRead); π end;π GetCheckSum := CSum;π end; { GetCheckSum }π π π beginπ assign(f, ParamStr(0));π {$I-} Reset(f,1);π With ExeData do beginπ first := FirstTime;π if FirstTime and (Ioresult = 0) then beginπ Seek(f,2); { this location has the executable size }π BlockRead(f,tbuff,4);π ExeSize := tbuff[0]+(pred(tbuff[1]) shl 9);π seek(f,8); { get the header size }π BlockRead(f,hsize,2);π FirstTime := False;π StartConst := LongInt(hsize+Seg(ExeData)-PrefixSeg) shl 4 + π ofs(ExeData) - 256;π CheckSum := GetCheckSum;π Seek(f,StartConst);π BlockWrite(f,ExeData,sizeof(ExeData));π seek(f,FileSize(f));π BlockWrite(f,StartConst,4);π endπ elseπ if GetCheckSum <> CheckSum then beginπ Writeln('File has been tampered with. Checksum incorrect');π halt;π end;π end; { With } π Close(f); {$I+}π if Ioresult <> 0 then beginπ Writeln('Unable to initialise Program');π halt;π end; π end; { InitConstants }πππFunction Write2Exec(Var data; size: Word): Boolean;π { Writes a new Typed Constant into the executable File after first checking }π { that it is safe to do so. It does this by ensuring that the IDString is }π { at the File offset expected. }π Constπ FName : str40 = '';π Varπ f : File;π st : str8;π BytesRead : Word;π beginπ if UseCfg then beginπ if length(FName) = 0 then beginπ TempStr := ParamStr(0);π TempStrLen := pos('.',TempStr) - 2;π FName := TempStr + ' . ';π { │ │││ }π { │ ││└────»» #255 }π { │ │└─────»» #32 }π { │ └──────»» #255 }π { └────────»» #255 }π { Using the above File name For the configuration File makes the }π { deletion of the File difficult For the average user. }π end; { if length }π assign(f, FName);π if exist(FName) then beginπ {$I-}π reset(f,1);π if first then beginπ first := False;π BlockRead(f, ExeData, ofs(mark)-ofs(ExeData),BytesRead)π end elseπ BlockWrite(f,data,size);π end else beginπ reWrite(f,1);π BlockWrite(f,Data,size);π end;π close(f);π {$I+}π Write2Exec := Ioresult = 0;π end else beginπ assign(f, ParamStr(0));π {$I-} Reset(f,1);π Seek(f,LongInt(ExeData.Hsize+Seg(ExeData)-PrefixSeg) shl 4π + ofs(ExeData)- 256);π BlockRead(f,st,9);π if st = ExeData.IDStr then { all Ok to proceed } beginπ Seek(f,LongInt(ExeData.Hsize+Seg(data)-PrefixSeg) shl 4π + ofs(data)- 256);π BlockWrite(f,data,size);π Close(f); {$I+}π Write2Exec := Ioresult = 0;π end elseπ Write2Exec := False;π end;π end; { Write2Exec }π πbeginπ first := True;π if not UseCfg thenπ InitConstantsπ elseπ Write2Exec(ExeData,ofs(mark)-ofs(ExeData));πend.π
